home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vb022e / vb022ex.bas < prev    next >
BASIC Source File  |  1995-09-06  |  9KB  |  264 lines
  1.  
  2.  
  3.  
  4. Sub CustomMsg (Message As String, IconNumber As Integer, MsgTitle As String, BoxWidth As Integer, BtnEnabled As Integer)
  5.     
  6.     Load MsgForm
  7.     MsgForm.WindowState = 0
  8.     MsgForm.Visible = 0
  9.  
  10.     If MsgTitle <> "" Then MsgForm.Caption = MsgTitle Else MsgForm.Caption = ""
  11.     
  12.     'SET WIDTH OF FORM
  13.     If BoxWidth <> 0 Then
  14.         MsgForm.width = BoxWidth
  15.     Else
  16.         MsgForm.width = 4545
  17.     End If
  18.     
  19.     'GET ICON: LOAD ICONNUMBER INTO TAG & SHOW IF SUCCESSFUL...
  20.     If IconNumber > 0 Then
  21.         On Error Resume Next
  22.         MsgForm.picIcon(0).picture = MsgForm.picIcon(IconNumber).picture
  23.         If Err Then
  24.             MsgForm.picIcon(0).Visible = 0
  25.             MsgForm.picIcon(0).Tag = "0"
  26.         Else
  27.             MsgForm.picIcon(0).Visible = -1
  28.             MsgForm.picIcon(0).Tag = Format$(IconNumber, "0")
  29.         End If
  30.         On Error GoTo 0
  31.     Else
  32.         MsgForm.picIcon(0).Visible = 0
  33.         MsgForm.picIcon(0).Tag = "0"
  34.     End If
  35.     
  36.     'POSITION, SIZE, ALIGN MESSAGE LABEL...
  37.     MsgForm.LblMsg.Alignment = 0
  38.     If MsgForm.picIcon(0).Tag <> "0" Then 'ICON SPECIFIED, LOADED...
  39.         MsgForm.LblMsg.left = (MsgForm.picIcon(0).left + MsgForm.picIcon(0).width + 120)
  40.         MsgForm.LblMsg.width = MsgForm.ScaleWidth - (MsgForm.picIcon(0).width) - (MsgForm.picIcon(0).left * 2) - 120
  41.     Else
  42.         MsgForm.LblMsg.left = MsgForm.picIcon(0).left
  43.         MsgForm.LblMsg.width = MsgForm.ScaleWidth - (MsgForm.LblMsg.left * 2)
  44.     End If
  45.     
  46.     'Get text in there!
  47.     Result% = WrapText(Message, MsgForm, MsgForm.LblMsg)
  48.     
  49.     ' make icon picture borderless
  50.     MsgForm.picIcon(0).BorderStyle = 0
  51.     
  52.     ' center Icon vertically next to label with message text
  53.     If MsgForm.LblMsg.height > MsgForm.picIcon(0).height Then ' MESSAGE TALLER THAN ICON
  54.         MsgForm.picIcon(0).top = MsgForm.LblMsg.top + (MsgForm.LblMsg.height / 2) - (MsgForm.picIcon(0).top / 2) - (MsgForm.picIcon(0).height / 2)
  55.     Else 'ICON TALLER THAN MESSAGE.
  56.         MsgForm.LblMsg.top = MsgForm.picIcon(0).top + (MsgForm.picIcon(0).height / 2) - (MsgForm.LblMsg.top / 2) - (MsgForm.LblMsg.height / 2)
  57.     End If
  58.     
  59.     HOffSet% = MsgForm.height - MsgForm.scaleheight
  60.     
  61.     ' Modal with OK button or not?
  62.     If BtnEnabled Then
  63.         MsgForm.btnOk.top = MsgForm.LblMsg.top + MsgForm.LblMsg.height + 120
  64.         MsgForm.btnOk.left = (MsgForm.ScaleWidth - MsgForm.btnOk.width) / 2
  65.         MsgForm.btnOk.Visible = -1
  66.         MsgForm.height = MsgForm.btnOk.top + MsgForm.btnOk.height + HOffSet% + 120
  67.     Else
  68.         MsgForm.btnOk.Visible = 0
  69.         MsgForm.height = MsgForm.LblMsg.top + MsgForm.LblMsg.height + HOffSet% + 120
  70.     End If
  71.     
  72.     
  73.     ' Centers message on the screen, but you can change this if you wish!
  74.     MsgForm.left = (Screen.width - MsgForm.width) / 2
  75.     MsgForm.top = (Screen.height - MsgForm.height) / 2
  76.     MsgForm.btnOk.Caption = "OK"
  77.     
  78.     If BtnEnabled Then
  79.         MsgForm.Show MODAL
  80.     Else
  81.         MsgForm.Show
  82.     End If
  83.  
  84. End Sub
  85.  
  86. Function WrapText (SourceTxt As String, DestForm As Form, DestCtrl As Control) As Integer
  87. '   SourceTxt is a string containing text to wrap.
  88. '   DestCtrl is the control to put the text in.
  89. '   DestForm is the the form the control is on.
  90.  
  91. 'This function copies the text to the destination,
  92. 'using different techniques based on the type of control passed.
  93.  
  94. 'ASSUMPTION IS the Width of the destination control
  95. 'is set and that it's height can be varied.
  96.     
  97.     Dim LF As String
  98.     LF = Chr$(13) + Chr$(10)
  99.     
  100.     'save these.
  101.     SavedFontName$ = DestForm.Fontname
  102.     SavedFontSize% = DestForm.FontSize
  103.     SavedFontBold% = DestForm.FontBold
  104.     SavedFontItal% = DestForm.FontItalic
  105.     
  106.     If TypeOf DestCtrl Is Picturebox Then
  107.         SavedScaleMode% = DestForm.DestCtrl.ScaleMode
  108.     End If
  109.  
  110.     'the form font properties should match
  111.     'the DestCtrl control's font properties for
  112.     'TextHeight/Width to work.
  113.     DestForm.Fontname = DestCtrl.Fontname
  114.     DestForm.FontSize = DestCtrl.FontSize
  115.     DestForm.FontItalic = DestCtrl.FontItalic
  116.     DestForm.FontBold = DestCtrl.FontBold
  117.  
  118.     ReDim CreatedTxt(100) As String
  119.     
  120.     SourceLength% = Len(SourceTxt)
  121.     LineQty% = 0
  122.     StartPlc% = 1
  123.     
  124.     '******** HERE'S THE LOOP TO SPLIT THE LINES***********************************
  125.     '******** AND LOAD THEM INTO AN ARRAY OF STRINGS.*******************************
  126.     Do
  127.         SpaceLoc% = InStr(StartPlc%, SourceTxt, " ")
  128.         LFLoc% = InStr(StartPlc%, SourceTxt, LF)
  129.         
  130.         If SpaceLoc% = 0 And LFLoc% = 0 Then
  131.             NextWord$ = Mid$(SourceTxt, StartPlc%)
  132.             
  133.         ElseIf SpaceLoc% <> 0 And LFLoc% = 0 Then
  134.             NextWord$ = Mid$(SourceTxt, StartPlc%, SpaceLoc% - StartPlc% + 1)
  135.         
  136.         ElseIf SpaceLoc% = 0 And LFLoc% <> 0 Then
  137.             NextWord$ = Mid$(SourceTxt, StartPlc%, LFLoc% - StartPlc% + 2)
  138.         
  139.         ElseIf SpaceLoc% <> 0 And LFLoc% <> 0 Then
  140.             'which comes first? Space or LF?
  141.             If SpaceLoc% < LFLoc% Then 'Space came first...
  142.                 NextWord$ = Mid$(SourceTxt, StartPlc%, SpaceLoc% - StartPlc% + 1)
  143.             Else
  144.                 NextWord$ = Mid$(SourceTxt, StartPlc%, LFLoc% - StartPlc% + 2)
  145.             End If
  146.         End If
  147.         
  148.         
  149.         TabLoc% = InStr(NextWord$, Chr$(9))
  150.         If TabLoc% <> 0 Then
  151.             Lft$ = Left$(NextWord$, InStr(NextWord$, Chr$(9)) - 1)
  152.             Rit$ = Mid$(NextWord$, InStr(NextWord$, Chr$(9)) + 1)
  153.             NextWord$ = Lft$ + Space$(gTabSize) + Rit$
  154.             DebugMsg$ = DebugMsg$ + "TAB Found at " + Format$(TabLoc%, "0") + LF
  155.         End If
  156.         
  157.         WordLen% = Len(NextWord$)
  158.         DebugMsg$ = DebugMsg$ + "Word found is [" + NextWord$ + "]" + LF
  159.         DebugMsg$ = DebugMsg$ + "Word Length is " + Format$(WordLen%) + LF
  160.         
  161.         If DestForm.TextWidth(CreatedTxt(LineQty%) + NextWord$) > DestCtrl.width Then
  162.             LineQty% = LineQty% + 1
  163.         End If
  164.         
  165.         CreatedTxt(LineQty%) = CreatedTxt(LineQty%) + NextWord$
  166.         StartPlc% = StartPlc% + WordLen%
  167.     
  168.         If StartPlc% >= SourceLength% Then Exit Do
  169.         
  170.     Loop
  171.     
  172.     If TypeOf DestCtrl Is Listbox Then GoSub FillList
  173.     If TypeOf DestCtrl Is ComboBox Then GoSub FillList
  174.     If TypeOf DestCtrl Is Label Then GoSub FillLabel
  175.     If TypeOf DestCtrl Is TextBox Then GoSub FillText
  176.     If TypeOf DestCtrl Is Picturebox Then GoSub PrintPic
  177.     
  178.     'restore form's font properties
  179.     DestForm.Fontname = SavedFontName$
  180.     DestForm.FontSize = SavedFontSize%
  181.     DestForm.FontBold = SavedFontBold%
  182.     DestForm.FontItalic = SavedFontItal%
  183.  
  184.     If TypeOf DestCtrl Is Picturebox Then DestCtrl.ScaleMode = SavedScaleMode%
  185.     
  186.     WrapText = -1
  187.  
  188.     
  189.     
  190. Exit Function
  191.  
  192. '-------------------------- SUBROUTINES-----------------------------
  193.     
  194. FillList:
  195.     Counter% = 0
  196.     DestCtrl.Visible = 0
  197.     x% = DoEvents()
  198.     If DestCtrl.Listcount <> 0 Then For R% = 0 To DestCtrl.Listcount - 1: DestCtrl.RemoveItem 0: Next R%
  199.     
  200.     Do
  201.         DestCtrl.AddItem CreatedTxt(Counter%), Counter%
  202.         Counter% = Counter% + 1
  203.         If CreatedTxt(Counter%) = "" Or CreatedTxt(Counter%) = LF Then Exit Do
  204.     Loop
  205.     DestForm.DestCtrl.Listindex = -1
  206.     DestForm.DestCtrl.height = Counter% * DestForm.TextHeight("A")
  207.     DestForm.DestCtrl.Visible = -1
  208.     DestForm.DestCtrl.Refresh
  209.     Return
  210.  
  211. FillLabel:
  212.     Counter% = 0
  213.     DestCtrl.Visible = -1
  214.     DestCtrl.Caption = ""
  215.     Do
  216.         If Not InStr(CreatedTxt(Counter%), LF) Then
  217.             Temp$ = Temp$ + CreatedTxt(Counter%) + LF
  218.         Else
  219.             Temp$ = Temp$ + CreatedTxt(Counter%)
  220.         End If
  221.         Counter% = Counter% + 1
  222.         If CreatedTxt(Counter%) = "" Then Exit Do
  223.     Loop
  224.     Counter% = Counter% + 1
  225.     DestCtrl.Caption = Temp$
  226.  
  227.  
  228.     'Remove Trailing Line feeds...
  229.     While Right$(DestCtrl.Caption, 2) = LF
  230.         DestCtrl.Caption = Left$(DestCtrl.Caption, Len(DestCtrl.Caption) - 2)
  231.     Wend
  232.  
  233.